Attribute VB_Name = "CreateMDB"
Option Explicit
'nome e testo query
Private Const Q_SPDELCD_NAME As String = "SPDelCD"
Private Const Q_SPDELCD_TEXT As String = "DELETE TblCD.IDCD From TblCD WHERE (((TblCD.IDcd)=[param]));"
Private Const Q_SPDELELEMENTO_NAME As String = "SPDelElemento"
Private Const Q_SPDELELEMENTO_TEXT As String = "PARAMETERS id Long;Delete TblElemento.IDElemento From TblElemento WHERE (((TblElemento.IDElemento)=[id]));"
Private Const Q_SPDELTIPO_NAME As String = "SPDelTipo"
Private Const Q_SPDELTIPO_TEXT As String = "Delete TblTipo.IDTipo From TblTipo WHERE (((TblTipo.IDTipo)=[param]));"
Private Const Q_SPESTENSIONI_NAME As String = "SPEstensioni"
Private Const Q_SPESTENSIONI_TEXT As String = "PARAMETERS param1 Long, param2 Text; UPDATE TblTipo SET TblTipo.EstensioniAssociate = [param2] WHERE (((TblTipo.IDTipo)=[param1]));"
Private Const Q_SPETICHETTE_NAME As String = "SPEtichette"
Private Const Q_SPETICHETTE_TEXT As String = "PARAMETERS param1 Long, param2 Text; UPDATE TblCD SET TblCD.EtichettaCD = [param2] WHERE (((TblCD.IDCD)=[param1]));"
Private Const Q_SPINS_NAME As String = "SPIns"
Private Const Q_SPINS_TEXT As String = "INSERT INTO tblElemento ( NomeFile, PercorsoFile, IDTipo, IDcd, Descrizione ) VALUES (Nome, Percorso, Tipo, CD, Descr);"
Private Const Q_SPINSCD_NAME As String = "SPInsCD"
Private Const Q_SPINSCD_TEXT As String = "INSERT INTO TblCD ( NomeCD ) VALUES (Nome);"
Private Const Q_SPINSCDLABEL_NAME As String = "SPInsCDLabel"
Private Const Q_SPINSCDLABEL_TEXT As String = "INSERT INTO TblCD ( NomeCD, EtichettaCD ) VALUES (Nome, Etichetta);"
Private Const Q_SPINSTIPO_NAME As String = "SPInsTipo"
Private Const Q_SPINSTIPO_TEXT As String = "INSERT INTO TblTipo ( NomeTipo ) VALUES (Nome);"
Private Const Q_SPUPDATEELEMENTO_NAME As String = "SPUpdateElemento"
Private Const Q_SPUPDATEELEMENTO_TEXT As String = "PARAMETERS id Long, param1 Text ( 255 ), param2 Long; UPDATE TblElemento SET TblElemento.Descrizione = [param1], TblElemento.IDTipo = [param2] WHERE (((TblElemento.IDElemento)=[ID]));"
Private Const Q_VIEWCD_NAME As String = "ViewCD"
Private Const Q_VIEWCD_TEXT As String = "SELECT TblCD.IDcd, TblCD.NomeCD FROM TblCD;"
Private Const Q_VIEWELEMENTO_NAME As String = "ViewElemento"
Private Const Q_VIEWELEMENTO_TEXT As String = "PARAMETERS Param Text ( 255 ); SELECT TblElemento.IDElemento, TblElemento.PercorsoFile+TblElemento.NomeFile AS NomeTotale, TblElemento.Descrizione, TblTipo.NomeTipo, TblCD.NomeCD FROM TblTipo INNER JOIN (TblCD INNER JOIN TblElemento ON TblCD.IDcd = TblElemento.IDcd) ON TblTipo.IDTipo = TblElemento.IDTipo WHERE (((TblElemento.Descrizione) ALike ""%"" & [Param] & ""%"")) OR ((([TblElemento].[PercorsoFile]+[TblElemento].[NomeFile]) ALike ""%"" & [Param] & ""%""));"
Private Const Q_VIEWELEMENTOCD_NAME As String = "ViewElementoCD"
Private Const Q_VIEWELEMENTOCD_TEXT As String = "PARAMETERS Param Text ( 255 ); SELECT TblElemento.IDElemento, TblElemento.PercorsoFile+TblElemento.NomeFile AS NomeTotale, TblElemento.Descrizione, TblTipo.NomeTipo, TblCD.NomeCD, TblCD.IDcd FROM TblTipo INNER JOIN (TblCD INNER JOIN TblElemento ON TblCD.IDcd = TblElemento.IDcd) ON TblTipo.IDTipo = TblElemento.IDTipo WHERE (((TblCD.IDcd)=[param]));"
Private Const Q_VIEWELEMENTOTIPO_NAME As String = "ViewElementoTipo"
Private Const Q_VIEWELEMENTOTIPO_TEXT As String = "PARAMETERS Param Text ( 255 ); SELECT TblElemento.IDElemento, TblElemento.PercorsoFile+TblElemento.NomeFile AS NomeTotale, TblElemento.Descrizione, TblTipo.NomeTipo, TblCD.NomeCD FROM TblTipo INNER JOIN (TblCD INNER JOIN TblElemento ON TblCD.IDcd = TblElemento.IDcd) ON TblTipo.IDTipo = TblElemento.IDTipo WHERE (((TblElemento.Descrizione) ALike ""%"" & [Param] & ""%"") AND ((TblTipo.NomeTipo)=[ID])) OR (((TblTipo.NomeTipo)=[ID]) AND (([TblElemento].[PercorsoFile]+[TblElemento].[NomeFile]) ALike ""%"" & [Param] & ""%""));"
Private Const Q_VIEWESTENSIONI_NAME As String = "ViewEstensioni"
Private Const Q_VIEWESTENSIONI_TEXT As String = "SELECT TblTipo.IDTipo, TblTipo.EstensioniAssociate, TblTipo.NomeTipo From TblTipo WHERE (((TblTipo.IDTipo)=[param]));"
Private Const Q_VIEWGETEXT_NAME As String = "ViewGetExt"
Private Const Q_VIEWGETEXT_TEXT As String = "SELECT TblTipo.IDTipo, TblTipo.NomeTipo, TblTipo.EstensioniAssociate From TblTipo WHERE (((TblTipo.EstensioniAssociate) ALike ""%;"" & [param] & "";%""));"
Private Const Q_VIEWGETIDCD_NAME As String = "ViewGetIDCD"
Private Const Q_VIEWGETIDCD_TEXT As String = "SELECT TblCD.IDcd From TblCD WHERE (((TblCD.NomeCD)=[param]));"
Private Const Q_VIEWGETIDELEMENTO_NAME As String = "ViewGetIDElemento"
Private Const Q_VIEWGETIDELEMENTO_TEXT As String = "SELECT TblElemento.IDElemento From TblElemento WHERE (((TblElemento.IDcd)=[param1]) AND ((TblElemento.NomeFile)=[param2]) AND ((TblElemento.PercorsoFile)=[param3]));"
Private Const Q_VIEWGETLABEL_NAME As String = "ViewGetLabel"
Private Const Q_VIEWGETLABEL_TEXT As String = "SELECT TblCD.IDcd, TblCD.NomeCD, TblCD.EtichettaCD From TblCD WHERE (((TblCD.EtichettaCD) ALike [param]));"
Private Const Q_VIEWLABEL_NAME As String = "ViewLabel"
Private Const Q_VIEWLABEL_TEXT As String = "SELECT TblCD.IDcd, TblCD.NomeCD, TblCD.EtichettaCD From TblCD WHERE (((TblCD.IDcd)=[param]));"
Private Const Q_VIEWTIPO_NAME As String = "ViewTipo"
Private Const Q_VIEWTIPO_TEXT As String = "SELECT TblTipo.IDTipo, TblTipo.NomeTipo, TblTipo.EstensioniAssociate FROM TblTipo;"

Public Function CreateDatabase(ByVal DBName As String) As Boolean
    On Error GoTo ErrorCreateDB
    Dim cat     As New ADOX.Catalog
    Dim Tbl(10) As ADOX.Table
    Dim Idx()   As ADOX.Index
    Dim msgErrR As Integer
    Dim sCnn    As String
    Dim i As Long
    Dim cmd As ADODB.Command
    Dim cnn As ADODB.Connection
    
    If DBName = vbNullString Then Exit Function
    sCnn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & vbBackSlash & DBName
    cat.Create sCnn
    
      '----------* Table Definition of TblCD *----------
      Set Tbl(6) = New ADOX.Table
      Tbl(6).ParentCatalog = cat
      With Tbl(6)
        .Name = "TblCD"
        .Columns.Append "EtichettaCD", adVarWChar, MAX_FIELD_LEN
          .Columns("EtichettaCD").Properties("Description").value = "Etchetta del CD"
          .Columns("EtichettaCD").Properties("Nullable").value = False
          .Columns("EtichettaCD").Properties("Jet OLEDB:Allow Zero Length").value = True
          '.Columns("EtichettaCD").Properties("Required").Value = False
        .Columns.Append "IDcd", adInteger
          .Columns("IDcd").Properties("AutoIncrement").value = True
          .Columns("IDcd").Properties("Nullable").value = False
          .Columns("IDcd").Properties("Jet OLEDB:Compressed UNICODE Strings").value = False
          '.Columns("IDcd").Properties("Required").Value = True
        .Columns.Append "NomeCD", adVarWChar, MAX_FIELD_LEN
        '.Columns("NomeCD").Properties("Required").Value = False
          .Columns("NomeCD").Properties("Description").value = "nome del cd"
      End With
      '----------* Index Definitions of TblCD *----------
      ReDim Idx(3)
      Set Idx(0) = New ADOX.Index
        Idx(0).Name = "IDcd"
        Idx(0).IndexNulls = adIndexNullsAllow
        Idx(0).Unique = True
          Idx(0).Columns.Append "IDcd"
      Set Idx(1) = New ADOX.Index
        Idx(1).Name = "NomeCD"
        Idx(1).IndexNulls = adIndexNullsAllow
        Idx(1).Unique = True
          Idx(1).Columns.Append "NomeCD"
      Set Idx(2) = New ADOX.Index
        Idx(2).Name = "PrimaryKey"
        Idx(2).PrimaryKey = True
        Idx(2).Unique = True
          Idx(2).Columns.Append "IDcd"
      Set Idx(3) = New ADOX.Index
        Idx(3).Name = "EtichettaCD"
        Idx(3).IndexNulls = adIndexNullsAllow
          Idx(3).Columns.Append "EtichettaCD"
      For i = 0 To UBound(Idx)
        Tbl(6).Indexes.Append Idx(i)
      Next i
    
      cat.Tables.Append Tbl(6)
    
      '----------* Table Definition of TblElemento *----------
      Set Tbl(7) = New ADOX.Table
      Tbl(7).ParentCatalog = cat
      With Tbl(7)
        .Name = "TblElemento"
        .Columns.Append "Descrizione", adLongVarWChar
          .Columns("Descrizione").Properties("Nullable").value = False
          '.Columns("Descrizione").Properties("Required").Value = True
          .Columns("Descrizione").Properties("Jet OLEDB:Compressed UNICODE Strings").value = False
          .Columns("Descrizione").Properties("Jet OLEDB:Allow Zero Length").value = True
        .Columns.Append "IDcd", adInteger
          '.Columns("IDcd").Properties("Default").Value = 0
          '.Columns("IDcd").Properties("Required").Value = True
          .Columns("IDcd").Properties("Jet OLEDB:Compressed UNICODE Strings").value = False
        .Columns.Append "IDElemento", adInteger
          .Columns("IDElemento").Properties("AutoIncrement").value = True
          .Columns("IDElemento").Properties("Nullable").value = False
          '.Columns("IDElemento").Properties("Required").Value = True
          .Columns("IDElemento").Properties("Jet OLEDB:Compressed UNICODE Strings").value = False
        .Columns.Append "IDTipo", adInteger
          '.Columns("IDTipo").Properties("Default").Value = 0
          '.Columns("IDTipo").Properties("Required").Value = True
          .Columns("IDTipo").Properties("Jet OLEDB:Compressed UNICODE Strings").value = False
        .Columns.Append "NomeFile", adVarWChar, 255
        .Columns.Append "PercorsoFile", adVarWChar, 255
          '.Columns("PercorsoFile").Properties("Required").Value = True
          .Columns("PercorsoFile").Properties("Jet OLEDB:Allow Zero Length").value = True
      End With
      '----------* Index Definitions of TblElemento *----------
      ReDim Idx(8)
      Set Idx(0) = New ADOX.Index
        Idx(0).Name = "IDElemento"
        Idx(0).IndexNulls = adIndexNullsAllow
        Idx(0).Unique = True
          Idx(0).Columns.Append "IDElemento"
      Set Idx(1) = New ADOX.Index
        Idx(1).Name = "PrimaryKey"
        Idx(1).PrimaryKey = True
        Idx(1).Unique = True
          Idx(1).Columns.Append "IDcd"
          Idx(1).Columns.Append "NomeFile"
          Idx(1).Columns.Append "PercorsoFile"
      Set Idx(2) = New ADOX.Index
        Idx(2).Name = "Descrizione"
        Idx(2).IndexNulls = adIndexNullsAllow
          Idx(2).Columns.Append "Descrizione"
      Set Idx(3) = New ADOX.Index
        Idx(3).Name = "IDcd"
        Idx(3).IndexNulls = adIndexNullsAllow
          Idx(3).Columns.Append "IDcd"
      Set Idx(4) = New ADOX.Index
        Idx(4).Name = "IDTipo"
        Idx(4).IndexNulls = adIndexNullsAllow
          Idx(4).Columns.Append "IDTipo"
      Set Idx(5) = New ADOX.Index
        Idx(5).Name = "NomeFile"
        Idx(5).IndexNulls = adIndexNullsAllow
          Idx(5).Columns.Append "NomeFile"
      Set Idx(6) = New ADOX.Index
        Idx(6).Name = "PercorsoFile"
        Idx(6).IndexNulls = adIndexNullsAllow
          Idx(6).Columns.Append "PercorsoFile"
      Set Idx(7) = New ADOX.Index
        Idx(7).Name = "TblCDTblElemento"
        Idx(7).IndexNulls = adIndexNullsAllow
        
        Idx(7).Columns.Append "IDcd"
      Set Idx(8) = New ADOX.Index
        Idx(8).Name = "TblTipoTblElemento"
        Idx(8).IndexNulls = adIndexNullsAllow
          Idx(8).Columns.Append "IDTipo"
      For i = 0 To UBound(Idx)
        Tbl(7).Indexes.Append Idx(i)
      Next i
    
      cat.Tables.Append Tbl(7)
    
      '----------* Table Definition of TblTipo *----------
      Set Tbl(8) = New ADOX.Table
      Tbl(8).ParentCatalog = cat
      With Tbl(8)
        .Name = "TblTipo"
        .Columns.Append "EstensioniAssociate", adLongVarWChar
          .Columns("EstensioniAssociate").Properties("Description").value = "le varie estensioni, separate da ;"
          '.Columns("EstensioniAssociate").Properties("Required").Value = True
          .Columns("EstensioniAssociate").Properties("Nullable").value = False
          '.Columns("EstensioniAssociate").Properties("Size").Value = 255
          '.Columns("EstensioniAssociate").Properties("Type").Value = "Memo"
          .Columns("EstensioniAssociate").Properties("Jet OLEDB:Allow Zero Length").value = True
        .Columns.Append MLSGetString("0316"), adInteger ' MLS-> "IDTipo"
          .Columns("IDTipo").Properties("AutoIncrement").value = True
          .Columns("IDTipo").Properties("Nullable").value = False
          '.Columns("IDTipo").Properties("Required").Value = False
          .Columns("IDTipo").Properties("Jet OLEDB:Compressed UNICODE Strings").value = False
        .Columns.Append "NomeTipo", adVarWChar, MAX_FIELD_LEN
          '.Columns("NomeTipo").Properties("Required").Value = False
          .Columns("NomeTipo").Properties("Description").value = "dati, programmi ecc..."
      End With
      '----------* Index Definitions of TblTipo *----------
      ReDim Idx(3)
      Set Idx(0) = New ADOX.Index
        Idx(0).Name = "IDTipo"
        Idx(0).IndexNulls = adIndexNullsAllow
        Idx(0).Unique = True
          Idx(0).Columns.Append "IDTipo"
      Set Idx(1) = New ADOX.Index
        Idx(1).Name = "NomeTipo"
        Idx(1).IndexNulls = adIndexNullsAllow
        Idx(1).Unique = True
          Idx(1).Columns.Append "NomeTipo"
      Set Idx(2) = New ADOX.Index
        Idx(2).Name = "PrimaryKey"
        Idx(2).PrimaryKey = True
        Idx(2).Unique = True
          Idx(2).Columns.Append "IDTipo"
      Set Idx(3) = New ADOX.Index
        Idx(3).Name = "EstensioniAssociate"
        Idx(3).IndexNulls = adIndexNullsAllow
          Idx(3).Columns.Append "EstensioniAssociate"
      For i = 0 To UBound(Idx)
        Tbl(8).Indexes.Append Idx(i)
      Next i
    
      cat.Tables.Append Tbl(8)
    
      'ora incomincia a creare le query
      Set cnn = New ADODB.Connection
      Set cmd = New ADODB.Command
      cnn.Open sCnn
      Set cmd.ActiveConnection = cnn
      Set cat.ActiveConnection = cnn
      
      cmd.CommandText = Q_SPDELCD_TEXT
      cat.Procedures.Append Q_SPDELCD_NAME, cmd
      
      Set cmd = New ADODB.Command
      cmd.CommandText = Q_SPDELELEMENTO_TEXT
      cat.Procedures.Append Q_SPDELELEMENTO_NAME, cmd
      
      Set cmd = New ADODB.Command
      cmd.CommandText = Q_SPDELTIPO_TEXT
      cat.Procedures.Append Q_SPDELTIPO_NAME, cmd
      
      Set cmd = New ADODB.Command
      cmd.CommandText = Q_SPESTENSIONI_TEXT
      cat.Procedures.Append Q_SPESTENSIONI_NAME, cmd
      
      Set cmd = New ADODB.Command
      cmd.CommandText = Q_SPETICHETTE_TEXT
      cat.Procedures.Append Q_SPETICHETTE_NAME, cmd
      
      Set cmd = New ADODB.Command
      cmd.CommandText = Q_SPINS_TEXT
      cat.Procedures.Append Q_SPINS_NAME, cmd
      
      'Set cmd = New ADODB.Command
      'cmd.CommandText = Q_SPINS_TEXT
      'cat.Procedures.Append Q_SPINSCD_NAME, cmd
      
      Set cmd = New ADODB.Command
      cmd.CommandText = Q_SPINSCD_TEXT
      cat.Procedures.Append Q_SPINSCD_NAME, cmd
      
      Set cmd = New ADODB.Command
      cmd.CommandText = Q_SPINSCDLABEL_TEXT
      cat.Procedures.Append Q_SPINSCDLABEL_NAME, cmd
      
      Set cmd = New ADODB.Command
      cmd.CommandText = Q_SPINSTIPO_TEXT
      cat.Procedures.Append Q_SPINSTIPO_NAME, cmd
      
      Set cmd = New ADODB.Command
      cmd.CommandText = Q_SPUPDATEELEMENTO_TEXT
      cat.Procedures.Append Q_SPUPDATEELEMENTO_NAME, cmd
      
      Set cmd = New ADODB.Command
      cmd.CommandText = Q_VIEWCD_TEXT
      cat.Procedures.Append Q_VIEWCD_NAME, cmd
      
      Set cmd = New ADODB.Command
      cmd.CommandText = Q_VIEWELEMENTO_TEXT
      cat.Procedures.Append Q_VIEWELEMENTO_NAME, cmd
      
      Set cmd = New ADODB.Command
      cmd.CommandText = Q_VIEWELEMENTOCD_TEXT
      cat.Procedures.Append Q_VIEWELEMENTOCD_NAME, cmd
      
      Set cmd = New ADODB.Command
      cmd.CommandText = Q_VIEWELEMENTOTIPO_TEXT
      cat.Procedures.Append Q_VIEWELEMENTOTIPO_NAME, cmd
      
      Set cmd = New ADODB.Command
      cmd.CommandText = Q_VIEWESTENSIONI_TEXT
      cat.Procedures.Append Q_VIEWESTENSIONI_NAME, cmd
      
      Set cmd = New ADODB.Command
      cmd.CommandText = Q_VIEWGETEXT_TEXT
      cat.Procedures.Append Q_VIEWGETEXT_NAME, cmd
      
      Set cmd = New ADODB.Command
      cmd.CommandText = Q_VIEWGETIDCD_TEXT
      cat.Procedures.Append Q_VIEWGETIDCD_NAME, cmd
      
      Set cmd = New ADODB.Command
      cmd.CommandText = Q_VIEWGETIDELEMENTO_TEXT
      cat.Procedures.Append Q_VIEWGETIDELEMENTO_NAME, cmd
      
      Set cmd = New ADODB.Command
      cmd.CommandText = Q_VIEWGETLABEL_TEXT
      cat.Procedures.Append Q_VIEWGETLABEL_NAME, cmd
      
      Set cmd = New ADODB.Command
      cmd.CommandText = Q_VIEWLABEL_TEXT
      cat.Procedures.Append Q_VIEWLABEL_NAME, cmd
      
      Set cmd = New ADODB.Command
      cmd.CommandText = Q_VIEWTIPO_TEXT
      cat.Procedures.Append Q_VIEWTIPO_NAME, cmd
      
      Set cat = Nothing
      Set cmd = Nothing
      Set cnn = Nothing
      
      'la compattadatabase si aspetta un db aperto da chiudere e riaprire
      Set conn = New ADODB.Connection
      conn.ConnectionString = ConnStr1 & App.Path & vbBackSlash & NomeDB
      conn.Open
      Call CompattaDatabase
      conn.Close
      
      CreateDatabase = True
      Exit Function
ErrorCreateDB:
    Err.Source = "CreateDatabase"
    'MsgBox Err.Description
    Resume Next
    GestisciErrore
    CreateDatabase = False
End Function
